home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / USERTRAC.I < prev    next >
Encoding:
Modula Implementation  |  1990-12-09  |  4.8 KB  |  194 lines
  1. IMPLEMENTATION MODULE UserTrace; (* V#015 *)
  2. (*$M-,S-,R-*)
  3.  
  4. (* Erstellt August '88 von Thomas Tempelmann, unter Megamax Modula-2 *)
  5. (* Anpassung an MOS V2 am 9.12.90 *)
  6.  
  7. FROM SYSTEM IMPORT ADR, ADDRESS, WORD, LONGWORD, BYTE, ASSEMBLER;
  8.  
  9. FROM PrgCtrl IMPORT TermProcess, CatchProcessTerm, TermCarrier;
  10.  
  11. FROM FastStrings IMPORT Assign, Length;
  12.  
  13. FROM MOSGlobals IMPORT UserBreak, MemArea;
  14.  
  15. FROM SysTypes IMPORT ScanDesc, ExcSet, TRAP5;
  16.  
  17. FROM AESForms IMPORT FormAlert;
  18.  
  19. FROM GEMScan IMPORT InputScan, InitChain, CallingChain;
  20.  
  21. FROM ShellMsg IMPORT ScanMode, ScanAddr, ErrorMsg, ScanIndex;
  22.  
  23. FROM Calls IMPORT CallSupervisor;
  24.  
  25.  
  26. VAR scan: ScanDesc;     (* Wird in 'trap5entry' initialisiert *)
  27.  
  28. VAR active: BYTE;       (* Semaphore zum Schutz vor Wiedereintritt *)
  29.  
  30.  
  31. PROCEDURE doStop;
  32.  
  33.   VAR ps: POINTER TO ARRAY [0..255] OF CHAR;
  34.       index, button: CARDINAL;
  35.       str: ARRAY [0..19] OF CHAR;
  36.  
  37.   BEGIN
  38.     InitChain (scan);
  39.     index:= 0;
  40.     str:= 'UserTrace-Stop   ';
  41.     InputScan (str, index);
  42.     FormAlert (2, '[0][  UserTrace-Stop  ][Quit|Cont|Edit]', button);
  43.     IF button = 3 THEN (* Edit *)
  44.       ScanMode := TRUE;
  45.       ScanIndex:= index;
  46.       Assign (str, ErrorMsg);
  47.       TermProcess (0)
  48.     ELSIF button = 1 THEN (* Quit *)
  49.       TermProcess (0)
  50.     END
  51.   END doStop;
  52.  
  53.  
  54. PROCEDURE callSub;
  55.   (*$L-*)
  56.   BEGIN
  57.     ASSEMBLER
  58.         ; Routine im User-Mode ausführen.
  59.         ; Dazu eigenen Stack verwenden.
  60.         ; Alter USP muß gerettet werden
  61.         
  62.         MOVE.L  USP,A1
  63.         MOVE.L  A1,-(A7)        ; alten Daten-Stack retten
  64.         
  65.         LEA     stackLo(PC),A3  ; Parameter-Stack setzen
  66.         LEA     stackHi(PC),A1
  67.         MOVE.L  A1,USP          ; Daten-Stack setzen
  68.         
  69.         ANDI    #$CFFF,SR       ; User Mode aktivieren
  70.         JSR     (A0)            ; Funktion aufrufen
  71.         
  72.         ; zurück in den Supervisor-Mode
  73.         CLR.L   -(A7)
  74.         MOVE    #$20,-(A7)
  75.         TRAP    #1
  76.         ADDQ.L  #6,A7
  77.         MOVE.L  D0,A7           ; SSP wiederherstellen
  78.         MOVE.L  (A7)+,A1
  79.         MOVE.L  A1,USP          ; USP wiederherstellen
  80.         RTS
  81.         
  82.       stackLo:
  83.         DS      2000            ; 2000 Byte für Stack reservieren
  84.       stackHi:
  85.     END
  86.   END callSub;
  87.   (*$L=*)
  88.  
  89.  
  90. PROCEDURE trap5entry;
  91.   (*$L-*)
  92.   BEGIN
  93.     ASSEMBLER
  94.         ; Wort nach TRAP 5 - Instr. prüfen
  95.         MOVE.L  A0,-(A7)
  96.         MOVE.W  D0,-(A7)
  97.         MOVE.L  8(SP),A0        ; PC laden
  98.         MOVE.W  (A0)+,D0
  99.         BEQ     check           ; es folgt Zeile -> Stop-Test
  100.         CMPI.W  #63,D0
  101.         BHI     check           ; Asm-Zeile oder Prozedurein-/ausstieg
  102.         MOVE.L  A0,8(SP)        ; PC hinter Debug-Datum setzen
  103.         LEA     sizeTable(PC),A0
  104.         MOVE.B  0(A0,D0.W),D0
  105.         EXT.W   D0
  106.         SUBA.W  D0,A3           ; Wert von A3-Stack ertfernen
  107.         MOVE.W  (A7)+,D0
  108.         MOVE.L  (A7)+,A0
  109.         RTE
  110.  
  111.       check:
  112.         MOVE.W  (A7)+,D0
  113.         TAS     active    ; ist Anfangs Null
  114.         BNE     ret       ; Stop-Routine braucht selber nicht getested werden
  115.  
  116.         MOVEM.L D0-D7/A1-A6,-(SP)
  117.  
  118.         MOVE.L  Stop,A0
  119.         JSR     callSub   ; Stop-Routine aufrufen
  120.         TST.W   -(A3)     ; Ergebnis von Funktion (BOOLEAN) abholen
  121.         BEQ     ende      ; Programm fortführen
  122.  
  123.         ; Programm stoppen
  124.         LEA     scan,A0
  125.         MOVE.L  62(SP),scan.pc(A0)      ; PC
  126.         MOVE.L  48(SP),scan.link(A0)    ; A5
  127.         MOVE.L  USP,A1
  128.         MOVE.L  A1,scan.stack(A0)       ; SP
  129.         LEA     doStop,A0
  130.         JSR     callSub
  131.      ende:
  132.         SF      active
  133.         MOVE.L  62(SP),A0
  134.         ADDQ.L  #2,A0
  135.         MOVEM.L (A7)+,D0-D7/A1-A6
  136.  
  137.      ret:
  138.         ; PC hinter Debug-Text setzen
  139.      l: TST.B   (A0)+
  140.         BNE     l
  141.         ADDQ.L  #1,A0
  142.         MOVE.L  A0,6(SP)
  143.         BCLR    #0,9(SP)  ; PC begradigen
  144.  
  145.         MOVE.L  (A7)+,A0
  146.         RTE
  147.         
  148.      sizeTable:
  149.         ; Tabelle mit Größen der Werte auf dem A3-Stack
  150.         DC.B    0,4,8,2,4,0,0,0,4,2,0,0,0,0,0,0,0,0,0,0,4,2,4,4,2,4,4,6,0,0
  151.         DC.B    4,0,0,2,2,2,0,0,2,2,4,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  152.         DC.B    0,0,0,0
  153.     END;
  154.   END trap5entry;
  155.   (*$L=*)
  156.  
  157.  
  158. PROCEDURE dummy (): BOOLEAN;
  159.   (*$L-*)
  160.   BEGIN
  161.     ASSEMBLER
  162.         CLR     (A3)+
  163.     END
  164.   END dummy;
  165.   (*$L=*)
  166.  
  167.  
  168. VAR     trap5exc [$94]: PROC;
  169.         oldtrap5: PROC;
  170.         hdl: TermCarrier;
  171.         wsp: MemArea;
  172.  
  173. PROCEDURE init (p: ADDRESS);
  174.   BEGIN
  175.     oldtrap5:= trap5exc;
  176.     trap5exc:= trap5entry;
  177.   END init;
  178.  
  179. PROCEDURE exit (p: ADDRESS);
  180.   BEGIN
  181.     trap5exc:= oldtrap5
  182.   END exit;
  183.  
  184. PROCEDURE terminate;
  185.   BEGIN
  186.     CallSupervisor (exit, NIL, wsp);
  187.   END terminate;
  188.   
  189. BEGIN
  190.   Stop:= dummy;
  191.   CallSupervisor (init, NIL, wsp);
  192.   CatchProcessTerm (hdl,terminate,wsp); (* wsp.bottom ist NIL *)
  193. END UserTrace.
  194.